Shareware Grab Bag/Shareware Grab Bag.iso/003/chrchpr2.arc/CSESETUP.CMD

Text File | 1979-12-31 | 14.0 KB | 480 lines

* Program CSESETUP - Sets up all functions for running CSEVENT
Store T to LEVEL2
Do while LEVEL2
  Erase
  @ 1,1 say  ename
  @ 2,1 say 'DATA DISK = '+D
  @ 1,62 say curdate
  @ 3,21 say ' CSEVENT Set-up Functions                  8-/CSESETUP/'
  @ 5,9 say  '1)  Create initial EVENT Names Directory (EDIRFILE)'
  @ 6,9 say '2)  Edit the Special Event basic information in EDIRFILE '
  @ 7,9 say  '3)  Create initial MEMBERSE file from MEMBERST '
  @ 8,9 say  '4)  Event Lodging names editing '
  @ 9,9 say  '5)  Event Session names editing '
  @ 10,9 say '6)  Event Transportation names editing '
  @ 11,9 say '7)  Display / Print the EDIRFILE'
  @ 12,9 say '8)  Re-index the MEMBERSE file '
  @ 13,9 say '9)  Re-index the EDIRFILE file '
?
Accept '         Enter selection ' to MSEL
?
Store F to valid2
Do while .NOT. valid2
  Store T to valid2
  Do CASE
    CASE MSEL = '1'
      ? 'Now about to delete any existing EDIRFILE to make a new, clear one.'
      Accept 'OK to proceed? ' to XX
      If !(xx)='Y'
      Select secondary
      Use edirfilx
      Copy to edirfile
      Use edirfile
      Set talk on
      Index on spact to edirfile
      Set talk off
      Use edirfile index edirfile
? 'The Special Event Names Directory has now been initialized for a new event.'
? 'You now need to perform Set-up function 2 - "Edit .. EDIRFILE"'
      Accept 'Press <retn> ' to xx
      else
        Accept  'No action is taken on the EDIRFILE. Press <retn> ' to xx
      endif
      Select primary
    CASE MSEL = '2'
      @ 17,12 say 'SPECIAL EVENT BASIC INFORMATION EDITING'
      Select secondary
      GOTO 2
      Store $(spact,21,1) to D
      SKIP
      Store $(spact,4,27) to ename
      SKIP
      Store $(spact,4,40) to eplace
      SKIP
      Store $(spact,4,40) to etime
      SKIP
      Store $(spact,9,8) to xx
      Store &xx to ecost
      @ 18,22 say 'DATA DISK ' get D
      @ 19,9 say 'EVENT NAME     ' get ENAME
      @ 20,9 say 'EVENT PLACE    ' get EPLACE
      @ 21,9 say 'EVENT DATE,TIME' get ETIME
      @ 22,9 say 'EVENT COST     ' get ECOST
      @ 23,12 say 'Press <ctrl-W> after editing'
      READ
      ? 'Now saving the above values in the EDIRFILE.'
      Replace spact with ' F Cost:'+str(ecost,8,2)
      GOTO 2
      Replace spact with $(spact,1,20)+D
      SKIP
      Replace spact with ' C '+ename
      SKIP
      Replace spact with ' D '+eplace
      SKIP
      Replace spact with ' E '+etime
      Use EDIRFILE INDEX EDIRFILE
      ? 'Now restoring local memory values.'
      Save to FMEMVARS
      Select primary
    CASE MSEL='3'
      Select primary
      Use MEMBERST
      ? 'WARNING - This routine deletes any existing MEMBERSE file '
      ? 'to make another on data disk = "',D,'".'
      Accept 'Are you sure you want to do this? ' to XX
      If !(XX)='Y'
        ? 'Now creating a new, empty MEMBERSE file.'
        Store D+':MEMBERSE' to MFILE
        Copy Structure to &MFILE
        Use &MFILE
        Index on last:name+first:name to &MFILE
        Use
Accept 'The MEMBERSE file and index have now been created. Press <retn> ' to xx
      else
        Accept 'No MEMBERSE file is made. Press <retn> ' to xx
      endif
    CASE MSEL = '4'
 Select secondary
 Store T to level3
 ? 'Now editing Lodging codes and names.'
 ?
 Do while level3
Accept 'Select:  A]dd   C]hange   D]elete   S]creen   V]erify   Q]uit ' to nsel
  Store F to valid2
  Do while .not.valid2
    If (!(nsel)='Q'.or.!(nsel)=' ').and.len(nsel)=1
      Store T to valid2
      Store F to level3
    else
      If @(!($(nsel,1,1)),'ADCSV')<>0
        Store T to valid2
      else
        Accept 'Invalid entry. Please enter again ' to nsel
      endif
    endif
  enddo
  If level3
   If !(nsel)='V'.or.!(nsel)='S'
    If !(nsel)='V'
? 'Now verifying the Lodging codes in all MEMBERSE records.'
Select primary
GOTO TOP
Do while .not. EOF
  If room<>'        '.and.$(room,9,1)<>'*'
  Store 'ROOM='+room to froom
  Store $(last:name,1,11)+' '+$(first:name,1,10) to fname
  Select secondary
  find &froom
  Store F to goodroom
  If #=0
    ? froom,fname,'*  Lodging not found.'
  else
    If $(spact,15,22)<>fname
      ? froom,fname,'*  Name does not match.'
    else
      Store T to goodroom
? 'GOOD ROOM: ',froom,fname,spact
    endif
  endif
  Select primary
  If .not. goodroom
    Replace room with $(room,1,8)+'*'
  endif
  endif
Accept 'NEXT' to xx
  SKIP
enddo
Accept 'All names are verified. Press <retn> ' to xx
     else
          Select secondary
          Store 'ROOM=' to infield
          ? '  Lodging names  -'
          Find &infield
          If #=0
            Accept 'No Lodging codes/names found. Press <retn> ' to xx
          else
            Set raw on
            Do while spact=infield.and..not.EOF
              Store $(spact,1,9) to innf
              ? '[',$(spact,6,3),']  ',$(spact,10,28)
              Do while (spact=innf.or.$(spact,11,1)='.').and..not.EOF
                SKIP
              enddo
            enddo
          endif
      endif
    else
    If len(nsel)>3
      Store $(nsel,2,3)+'  ' to cchng
      Store $(nsel,1,1) to nsel
    else
      Accept 'Enter a Lodging code ' to cchng
      Store cchng+'  ' to cchng
    endif
    If !(cchng)='Q  '
      Store F to level3
    else
      Store 'ROOM='+cchng to ichng
      Find &ichng
      Do CASE
      CASE !(nsel)='A'
        If #<>0
        ? 'This Lodging code already exists.'
        else
        Accept 'Enter a Lodging name for this code ' to ccname
        Store ccname+'  ' to ccname
        If !(ccname)='Q  ' .or. !(ccname)='   '
          ? 'No entry is made.'
        else
          Append blank
          Replace spact with ichng+ccname
          ? 'New Lodging is:   ',spact
        endif
        endif
      CASE !(nsel)='D'
        If #=0
          ? 'This code is not found.'
        else
          ? 'Deleted Lodging is:   ',spact
          Replace spact with $(spact,1,8)+'.'
          Delete
        endif
      CASE !(NSEL)='C'
        If #=0
          ? 'This code is not found.'
        else
          ? 'Lodging being changed is:   ',spact
          Accept 'Enter a new Lodging name for this code ' to ccname
          Store ccname+'  ' to ccname
          If !(ccname)='Q  '.or.ccname='   '
            ? 'No change is made.'
          else
            Replace spact with $(spact,1,10)+ccname
          endif
        endif
      ENDCASE
    endif
  endif
  enddo
    CASE MSEL='5'
Select secondary
Store T to level3
 ? 'Now editing Session codes and names.'
 ?
 Do while level3
  Accept 'Select:  A]dd   C]hange   D]elete   S]creen   Q]uit  ' to nsel
  Store F to valid2
  Do while .not.valid2
    If (!(nsel)='Q'.or.!(nsel)=' ').and.len(nsel)=1
      Store T to valid2
      Store F to level3
    else
      If @(!($(nsel,1,1)),'ADCS')<>0
        Store T to valid2
      else
        Accept 'Invalid entry. Please enter again ' to nsel
      endif
    endif
  enddo
  If level3
    If !(nsel)='S'
          Select secondary
          Store 'SESS=' to infield
          ? '  Session names  -'
          Find &infield
          If #=0
            Accept 'No Session codes/names found. Press <retn> ' to xx
          else
            Set raw on
            Do while spact=infield.and..not.EOF
              Store $(spact,1,11) to innf
              ? '[',$(spact,6,5),']  ',$(spact,11,28)
              Do while (spact=innf.or.$(spact,11,1)='.').and..not.EOF
                SKIP
              enddo
            enddo
          endif
      else
    If len(nsel)>5
      Store $(nsel,2,5)+'  ' to cchng
      Store $(nsel,1,1) to nsel
    else
      Accept 'Enter a Session code ' to cchng
      Store cchng+'      ' to cchng
      Store $(cchng,1,5)+'  ' to cchng
    endif
    If !(cchng)='Q  '
      Store F to level3
    else
      Store 'SESS='+cchng to ichng
      Find &ichng
      Do CASE
      CASE !(nsel)='A'
        If #<>0
        ? 'This Session code already exists.'
        else
        Accept 'Enter a Session name for this code ' to ccname
        Store ccname+'  ' to ccname
        If !(ccname)='Q  ' .or. !(ccname)='   '
          ? 'No entry is made.'
        else
          Append blank
          Replace spact with ichng+ccname
          ? 'New Session is:   ',spact
        endif
        endif
      CASE !(nsel)='D'
        If #=0
          ? 'This code is not found.'
        else
          ? 'Deleted Session is:   ',spact
          Replace spact with $(spact,1,10)+'.'
          Delete
        endif
      CASE !(NSEL)='C'
        If #=0
          ? 'This code is not found.'
        else
          ? 'Session being changed is:   ',spact
          Accept 'Enter a new Session name for this code ' to ccname
          Store ccname+'  ' to ccname
          If !(ccname)='Q  '.or.ccname='   '
            ? 'No change is made.'
          else
            Replace spact with $(spact,1,12)+ccname
          endif
        endif
      ENDCASE
    endif
   endif
  endif
  enddo
    CASE MSEL='6'
Select secondary
Store T to level3
 ? 'Now editing Transportation codes and names.'
 ?
 Do while level3
Accept 'Select:  A]dd   C]hange   D]elete   S]creen   V]erify   Q]uit ' to nsel
  Store F to valid2
  Do while .not.valid2
    If (!(nsel)='Q'.or.!(nsel)=' ').and.len(nsel)=1
      Store T to valid2
      Store F to level3
    else
      If @(!($(nsel,1,1)),'ADCSV')<>0
        Store T to valid2
      else
        Accept 'Invalid entry. Please enter again ' to nsel
      endif
    endif
  enddo
  If level3
   If !(nsel)='V'.or.!(nsel)='S'
    If !(nsel)='V'
? 'Now verifying the Transportation codes in all MEMBERSE records.'
Select primary
GOTO TOP
Do while .not. EOF
  If transpor<>'     '.and.$(transpor,6,1)<>'*'
  Store $(last:name,1,11+' '+$(first:name,1,10) to fname
  Store 'TRAN='+transpor+fname to froom
  Select secondary
  find &froom
  If #=0
    ? froom,fname,'*  Transportation/Name not found.'
    Select primary
    Replace transpor with $(transpor,1,5)+'*'
  else
    Select primary
  endif
  endif
  SKIP
enddo
Accept 'All names are verified. Press <retn> ' to xx
    else
          Select secondary
          Store 'TRAN=' to infield
          ? '  Transportation names  -'
          Find &infield
          If #=0
            Accept 'No Transportation codes found. Press <retn> ' to xx
          else
            Set raw on
            Do while spact=infield.and..not.EOF
              Store $(spact,1,11) to innf
              ? '[',$(spact,6,5),']  ',$(spact,11,28)
              Do while (spact=innf.or.$(spact,11,1)='.').and..not.EOF
                SKIP
              enddo
            enddo
          endif
   endif
  else
    If len(nsel)>5
      Store $(nsel,2,5)+'  ' to cchng
      Store $(nsel,1,1) to nsel
    else
      Accept 'Enter a Transportation code ' to cchng
      Store cchng+'      ' to cchng
      Store $(cchng,1,5)+'  ' to cchng
    endif
    If !(cchng)='Q  '
      Store F to level3
    else
      Store 'TRAN='+cchng to ichng
      Find &ichng
      Do CASE
      CASE !(nsel)='A'
        If #<>0
        ? 'This Transportation code already exists.'
        else
        Accept 'Enter a Transportation name for this code ' to ccname
        Store ccname+'  ' to ccname
        If !(ccname)='Q  ' .or. !(ccname)='   '
          ? 'No entry is made.'
        else
          Append blank
          Replace spact with ichng+ccname
          ? 'New Transportation is:   ',spact
        endif
        endif
      CASE !(nsel)='D'
        If #=0
          ? 'This code is not found.'
        else
          ? 'Deleted Transportation is:   ',spact
          Replace spact with $(spact,1,10)+'.'
          Delete
        endif
      CASE !(NSEL)='C'
        If #=0
          ? 'This code is not found.'
        else
          ? 'Transportation being changed is:   ',spact
          Accept 'Enter a new Transportation name for this code ' to ccname
          Store ccname+'  ' to ccname
          If !(ccname)='Q  '.or.ccname='   '
            ? 'No change is made.'
          else
            Replace spact with $(spact,1,12)+ccname
          endif
        endif
      ENDCASE
    endif
   endif
  endif
  enddo
    CASE MSEL = '7'
      ?
      ? 'Now displaying the EDIRFILE.  '
      Select secondary
      GOTO top
      SKIP
      Do while .not. EOF
        ? spact
        SKIP
      enddo
      Accept 'Report is complete. Press <retn> ' to xx
    CASE MSEL = '8'
      Select primary
      Store D+':MEMBERSE' to mfile
      Use &MFILE
      ? 'Now re-indexing the MEMBERSE file.'
      Set talk on
      Index on last:name+first:name to &MFILE
      Set talk off
      Use &MFILE index &MFILE
      Accept 'MEMBERSE file is now re-indexed. Press <retn>' to xx
    CASE MSEL = '9'
      Select secondary
      Use EDIRFILE
      ? 'Now re-indexing the EDIRFILE file.'
      Set talk on
      Index on spact to EDIRFILE
      Set talk off
      Use EDIRFILE index EDIRFILE
      Select primary
      Accept 'The EDIRFILE file is now re-indexed. Press <retn>' to xx
    CASE !(MSEL) = 'Q'
      Store F to LEVEL2
      RETURN
    OTHERWISE
      Accept 'Illegal selection. Please enter again ' to MSEL
      Store F to valid2
  ENDCASE
ENDDO
enddo
RETURN


Andersen       Ann           Andersen       Gary          Andersen       Norm          Andersen       Patricia      Baker          Diane         Baker          Dr. Kenneth   Baker          Greg          Baker          Jim               Baker          John
Baker          Karen         Barry          Alice         Baxter         Alan          Bezanson       Janet         Bezanson       Jim           Bloomgren      Ellen         Brunell     
      Select secondary
      GOTO top
      SKIP
      Do while .not. EOF
        ? spact
        SKIP
      enddo
      Accept 'Report is complete. Press <retn> ' to xx